perm filename TSERVO.FAI[C,BGB] blob
sn#101487 filedate 1974-05-13 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00016 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 ALTERNATE PDP-10 MNEMONICS.
C00006 00003 TITLE TSERVO - TABLE TEST
C00010 00004 TURN TABLE (SUB MODE) COMMAND LISTEN LOOP.
C00012 00005 SUBROUTINE TO RUN SPACE WAR JOBS.
C00014 00006 COMMAND EXECUTION.
C00018 00007 TURN TABLE SERVO. PDP-6 SPACE WAR JOB.
C00024 00008 VARIABLES.
C00026 00009 DISPLAY TURN TABLE STATUS.
C00030 00010 III DISPLAY SUBROUTINES.
C00032 00011 III DPY CONTINUED.
C00034 00012 III DISPLAY ROUTINES.
C00036 00013 SUBR(SQRT)
C00038 00014 BEGIN SINCOS SINE & COSINE - BGB.
C00040 00015 SUBR(READARC) RETURNS RADIANS.
C00042 00016 BEGIN REALIN INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
C00044 ENDMK
C⊗;
;ALTERNATE PDP-10 MNEMONICS.
DEFINE O(A,B){OPDEF A[B]}
O LIP,HLR↔O LAP,HRR↔O DIP,HRLM↔O DAP,HRRM
O ZIP,HRRZS↔O ZAP,HLLZS↔O WIP,HRROS↔O WAP,HRRZS
O CAR,HLRZ↔O LIPI,HRLI↔O LAPI,HRRI↔O DIPZ,HRLZM
O CDR,HRRZ↔O LACI,MOVEI↔O SLACI,MOVSI↔O DAPZ,HRRZM
O LAC,MOVE↔O LACN,MOVN↔O LACM,MOVM↔O SLAC,MOVS
O DAC,MOVEM↔O DACN,MOVNM↔O DACM,MOVMM↔O SDAC,MOVSM
O NIP,HLRE↔O NAP,HRRE↔O NIM,HRREI↔O GO,JRST
O FLOAT,FSC 233↔O FLO,FSC 225↔O FIXX,FIX 233000
O DZM,SETZM
;SAIL LIKE SUBROUTINE LINKAGE.
↓P←←17
DEFINE SUBR(NAME){↓NAME: ;}
DEFINE CALL(NAME,X1,X2,X3,X4){
IFDIF <> <X1> {PUSH 17,X1↔IFDIF <> <X2> {PUSH 17,X2
IFDIF <> <X3> {PUSH 17,X3↔IFDIF <> <X4> {PUSH 17,X4}}}}
PUSHJ 17,NAME}
DEFINE ARG1<-1(17)>↔DEFINE ARG2<-2(17)>
DEFINE ARG3<-3(17)>↔DEFINE ARG4<-4(17)>
DEFINE SETQ(VAR,LIST){CALL(LIST)↔DAC 1,VAR}
;RETURN FROM AN N-ARGUMENT SUBROUTINE CALL.
DEFINE POP0J <POPJ 17,>
↓POP1J.:SUB 17,[2(2)]↔GO@2(17)↔DEFINE POP1J<GO POP1J.>
↓POP2J.:SUB 17,[3(3)]↔GO@3(17)↔DEFINE POP2J<GO POP2J.>
↓POP3J.:SUB 17,[4(4)]↔GO@4(17)↔DEFINE POP3J<GO POP3J.>
↓POP4J.:SUB 17,[5(5)]↔GO@5(17)↔DEFINE POP4J<GO POP4J.>
;ACCUMULATOR AND TEMPORARY DATA MANAGEMENT.
DEFINE ACCUMULATORS(LIST){ACPTR←←2
FOR AC⊂(LIST)<AC←ACPTR↔ACPTR←←ACPTR+1↔>}
DEFINE DECLARE (LIST){
FOR VARNAM⊂(LIST)<VARNAM: 0↔>}
;FATAL ERROR MESSAGE.
DEFINE FATAL(STR){PUSHJ 17,FATAL.↔ASCIZ/STR/}
FATAL.:OUTSTR[BYTE(7)15,12,106,101,124↔"AL - "⊗1↔0]
OUTSTR @(17)↔INCHRW↔GO .-1↔LIT
DEFINE CRLF{OUTSTR[BYTE(7)15,12]}
%←1B18
TITLE TSERVO - TABLE TEST
COMMENT ⊗------------------------------------------------------------
Run Turn table:
DATAO 500,[speed(5)]
;Speed 0 TO 77 turn counter clockwise.
;Speed 100 to 176 turn clockwise.
;speed 177 stop and lock.
;Speed 200 table time out.
Read Turn Table Counter:
DATAI 410,X ;Read Turn Table. 1B18 count invalid bit.
; 1B17 IS =10000 bit followed by
; four 4-bit bytes containing BCD numerals.
Reset Turn Table Counter:
CONO 410,0 ;Reset table count to zero.
;=10 arcs of =2000 counts.
;-------------------------------------------------------------------⊗
;INITIALIZATION.
PDL: BLOCK 30 ;USER LEVEL JOB CONTROL PDL.
SA: CALLI
REE: MOVE P,[IOWD 20,PDL]
MOVEI REE
MOVEM 124
SETZ ;NO CRE COMMAND CHARACTER.
PPIOT 2,-=100
PPIOT 3,4004
;--------------------------------------------------------------------
;DISPLAY BOX, TITLES AND CIRCLE ON GLASS 16.
XTABLE↑:DAC CRECHR# ;CRE COMMAND CHARACTER.
CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[3])
CALL(AIVECT,[-=500],[=450]);
CALL(DPYSTR,{[[ASCIZ/
TURN TABLE COMMANDS:
A<ARC> MOVE TABLE TO ABSOLUTE POSITION
D<ARC> SET DELTA ARC ARGUMENT
Y MOVE DELTA ARC
L ISSUE TURN TABLE LOCK COMMAND
Z MOVE TABLE TO CURRENT ZERO POSITION
R READ AND DISPLAY TURN TABLE STATUS
E EXIT THE TSERVO PROGRAM./]]})
;CIRCLE FOR INDICATING TABLE POSITION.
CALL(AIVECT,[=450],[=180])↔SETZM TTRAD1
CIR1: CALL(COS,TTRAD1)↔FMPR 1,[200.0]↔FIXX 1,↔ADDI 1,=250↔PUSH P,1
CALL(SIN,TTRAD1)↔FMPR 1,[200.0]↔FIXX 1,↔ADDI 1,=180↔PUSH P,1
CALL(AVECT)
LAC TTRAD1↔FADR[0.125664]↔DAC TTRAD1
CAMG[6.29]↔GO CIR1↔SETZM TTRAD1
CALL(DPYOUT,[16])
CALL(XREAD)
;--------------------------------------------------------------------
;TURN TABLE (SUB MODE) COMMAND LISTEN LOOP.
LOOP: SKIPE CRECHR↔GO[
LAC CRECHR↔CAIE"U"↔GO .+2
SETZM CRECHR ;"U" - ENTER TURN TABLE LOOP.
CRLF↔OUTSTR[ASCIZ" #"]
GO .+2]
;GET A CHARACTER AND ITS CONTROL BITS.
INCHRW
SETZM CTRL↔TRZE 200↔SETOM CTRL#
SETZM META↔TRZE 400↔SETOM META#
CAIN 15↔GO[INCHRS↔CRLF↔OUTSTR[ASCIZ" #"]↔GO LOOP]
DAC CHR#↔SETZ 1, ;NO OPERATION.
;DECODE AND DISPATCH.
CAIN "A"↔LACI 1,XABSOL ;ABSOLUTE TABLE POSITION.
CAIN "Y"↔LACI 1,XGO
CAIN "Z"↔LACI 1,XZHALT ;GO TO ZERO POSITION.
CAIN "R"↔LACI 1,XREAD ;READ TURN TABLE POSITION.
CAIN "D"↔LACI 1,XDELTA ;SET TURN TABLE DELTA.
CAIN "L"↔LACI 1,XLOCK ;EXECUTE LOCK COMMAND.
CAIN "E"↔GO TTEXIT ;EXIT TURN TABLE LOOP.
JUMPE 1,LOOP ;COMMAND LETTER NOT IMPLEMENTED.
PUSHJ P,(1) ;EXECUTE COMMAND.
SKIPN CRECHR↔GO LOOP
;TURN TABLE SUB-COMMAND LOOP EXIT - TAKE GLASS DOWN.
TTEXIT: SETZB 0,1↔UPGIOT 16,↔UPGIOT 15,↔POP0J
;--------------------------------------------------------------------
;SUBROUTINE TO RUN SPACE WAR JOBS.
SUBR(SWJOBS)
BEGIN SWJOBS;--------------------------------------------------------
SETZM DONE ;PDP-6 JOB DONE FLAG.
SPCWAR 1,PDP6 ;FIRE UP PDP-6 EVER TICK.
LAC[XWD %+10,PDP10]
SPCWGO ;FIRE UP PDP10 DISPLAY JOB.
L1: INCHRS ;SKIP ON A CHARACTER.
SKIPA↔SETOM DONE ;SET DONE BECAUSE OF CHARACTER.
SKIPN DONE↔GO L1 ;WAIT FOR PDP-6 JOB DONE.
LACI 2↔SLEEP ;WAIT'A'SECOND OR TWO.
DZM DONE↔SKIPN DONE↔GO .-1 ;WAIT FOR PDP-6 JOB DONE AGAIN.
DZM DONE10↔SKIPN DONE10↔GO .-1
SPCWAR'SSW'↔POP0J ;STOP SPACE JOBS AND EXIT.
;--------------------------------------------------------------------
PDP10: CONSO 40↔DISMIS ;ARE WE REALLY ON THE PDP-10.
GO 3,@[.+1] ;LEAVE IOT USER MODE.
LAC 17,[IOWD 20,PDL10] ;PDP-10 DISPLAY JOB.
CALL(TTDPY) ;DISPLAY ROUTINE.
SETOM DONE10↔DISMIS ;OVER AND OUT.
PDL10: BLOCK 20
DONE10: 0
BEND SWJOBS;---------------------------------------------------------
;COMMAND EXECUTION.
;SET ABSOLUTE TURN TABLE POSITION. "A"<ARC>;
XABSOL: CALL(READARC)↔MOVMS ;DESIRED POSITION IN RADIANS.
CAMG[6.283185]↔GO .+3 ;MODULO 2π.
FSBR[6.283185]↔GO .-3↔SKIPA
;SET TURN TABLE TO ORIGIN. "Z";
XZHALT: SETZ↔DAC 0,TTRAD0 ;MOVE TABLE TO ZERO POSITION.
FDVR 0,TTUNIT↔FIXX
DAC TTPOS0 ;DESIRED TURN TABLE POSITION.
CALL(SWJOBS)
SKIPN TTRAD0↔CRLF
OUTSTR[ASCIZ" #"]
POP0J
;--------------------------------------------------------------------
;MOVE TURN TABLE ONE DELTA ARC. "Y";
XGO: LAC DELARC ;IN TURN TABLE UNITS.
SKIPE CTRL↔MOVNS
ADD TTPOS0 ;NOTA BENE: DESIRED POSITION.
XGO2: CAIGE =00000↔ADDI =20000
CAIL =20000↔SUBI =20000
SKIPL↔CAIL =20000↔GO XGO2 ;MAKE DAMN SURE.
DAC TTPOS0 ;DESIRED TURN TABLE POSITION.
CALL(SWJOBS)
POP0J
;--------------------------------------------------------------------
;SET DELTA ARC. "D"<ARC>;
XDELTA: CALL(READARC)↔MOVMS ;RADIANS.
FDVR TTUNIT↔FADR[0.5] ;UNITS OF π/10000; TT-UNITS.
FIXX↔DAC DELARC
OUTSTR[ASCIZ" #"]
POP0J
;--------------------------------------------------------------------
XREAD: SETZM DONE↔SETOM ROFLAG# ;READ ONLY TURN TABLE POSITION.
SPCWAR PDP6 ;FIRE UP PDP-6 ONE TICK.
SKIPN DONE↔GO .-1 ;WAIT FOR PDP-6 DONE.
SETZM ROFLAG
SPCWAR'SSW'↔CALL(TTDPY)
SKIPE CRECHR↔POP0J
CRLF↔OUTSTR[ASCIZ" #"]
POP0J
;--------------------------------------------------------------------
;LOCK THE TURN TABLE COMMAND. "L".
XLOCK: SETZM LOCKFLG#
SPCWAR 0,TTLOCK
SKIPN LOCKFLG↔GO .-1
OUTSTR[ASCIZ/ DONE.
#/]↔POP0J
TTLOCK: CONSZ 40↔DISMIS ;ARE WE REALLY ON THE PDP-6.
DATAO 500,[XWD 5,177] ;LOCK.
SETOM LOCKFLG
DISMIS
;--------------------------------------------------------------------
;TURN TABLE SERVO. PDP-6 SPACE WAR JOB.
PDP6:
BEGIN PDP6;---------------------------------------------------------
CONSZ 40↔DISMIS ;ARE WE REALLY ON THE PDP-6.
;READ TURN TABLE POSITION & DECODE BCD TO BINARY.
DATAI 410,TTREAD ;READ CURRENT TT POSITION.
LAC 2,[POINT 4,TTREAD,15]
ILDB 0,2 ;TEN THOUSAND.
ILDB 1,2↔IMULI 0,=10↔ADD 0,1 ;THOUSANDS.
ILDB 1,2↔IMULI 0,=10↔ADD 0,1 ;HUNDREDS.
ILDB 1,2↔IMULI 0,=10↔ADD 0,1 ;TENS.
ILDB 1,2↔IMULI 0,=10↔ADD 0,1 ;ONES.
DAC 0,TTPOS1 ;SAVE CURRENT TT POSITION.
LAC TTREAD↔TRNE %↔GO INVALID ;RESET INVALID BIT.
SKIPE ROFLAG↔GO[ ;READ ONLY FLAG.
SETOM DONE↔DISMIS]
;STOP CONDITION: ABS(TTPOS0-TTPOS1) ≤ =40
LAC 0,TTPOS0 ;DESIRED POSITION.
LAC 1,TTPOS1 ;ACTUAL POSITION.
L2: LAC 2,0↔SUB 2,1 ;DIFFERENCE IN POSITIONS.
DAC 2,TTDIR↔MOVMS 2 ;DIRECTION TO MOVE.
CAIGE 2,=25↔GO STOPTT ;TOLERANCE.
;MAKE CORRECTIONS MODULO =20,000 WHEN DIFFERENCE > =10,000.
CAILE 2,=10000↔GO[
CAILE 0,=10000↔SUBI 0,=20000
CAILE 1,=10000↔SUBI 1,=20000↔GO L2]
;SEND A TURN TABLE COMMAND.
L3: LACI 30 ;TURN TABLE VELOCITY.
SKIPL TTDIR↔MOVNS
ANDI 176↔IORI 200 ;200 BIT FOR TIME OUT.
DAP TTOUT
DATAO 500,TTOUT ;SEND TURN TABLE COMMAND.
DISMIS
↑TTOUT: XWD 5,0 ;TURN TABLE COMMAND.
;--------------------------------------------------------------------
INVALID: CONO 410,0 ;RESET INVALID.
AOS INVCNT
STOPTT: DATAO 500,[XWD 5,0] ;STOP THE TURN TABLE.
SETOM DONE↔DISMIS ;STOP RUNNING THE TURN TABLE.
BEND PDP6;-----------------------------------------------------------
;VARIABLES.
DONE: 0 ;PDP-6 SPACE WAR JOB DONE.
TTDIR: 0 ;TURN TABLE DIRECTION.
TTREAD: 0 ;TURN TABLE SHAFT POSITION.
TTPOS0: 0 ;DESIRED POSITION MARK IN TURN TABLE UNITS.
TTPOS1: 0 ;CURRENT POSITION MARK IN TURN TABLE UNITS.
DELARC: 0 ;DELTA ARC IN TURN TABLE UNITS.
TTRAD0: 0 ;DESIRED POSITION IN RADIANS.
TTRAD1: 0 ;CURRENT POSITION IN RADIANS.
TTDEGS: 0 ;CURRENT POSITION IN DEGREES (FOR DISPLAY ONLY).
INVCNT: 0 ;COUNT OF INVALID HITS.
TTUNIT: 3.14159265E-4 ;A TURN TABLE UNIT IN RADIANS.
;--------------------------------------------------------------------
;DISPLAY TURN TABLE STATUS.
TTDPY: CALL(DPYSET,DPYBUF)
CALL(DPYBIG,[2])
;COMPUTE TURN TABLE POSITIONS IN RADIANS AND DEGREES.
LAC TTPOS1↔FLOAT↔FMPR TTUNIT↔DAC TTRAD1
LAC TTPOS0↔FLOAT↔FMPR TTUNIT↔DAC TTRAD0
LAC TTRAD1↔FMPR[57.2957795]↔FADR[0.5]↔FIXX↔DAC TTDEGS
;DISPLAY TURN TABLE POSITION ANGLE.
CALL(AIVECT,[=200],[=180])↔LAC 1,TTPOS1↔CALL(DECDPY)
CALL(DPYSTR,{[[ASCIZ/ TT UNITS./]]})
CALL(AIVECT,[=200],[=150])↔LAC 10,TTREAD↔CALL(OD)
CALL(DPYSTR,{[[ASCIZ/ TT OCTAL./]]})
CALL(AIVECT,[=200],[=210])↔LAC 1,TTDEGS↔CALL(DECDPY)
CALL(DPYSTR,{[[ASCIZ/ DEGREES./]]})
;INDICATE CURRENT AND DESIRED TURN TABLE POSITION ON A CIRCLE.
CALL(AIVECT,[=250],[=180])
CALL(COS,TTRAD1)↔FMPR 1,[200.0]↔FIXX 1,↔ADDI 1,=250↔PUSH P,1
CALL(SIN,TTRAD1)↔FMPR 1,[200.0]↔FIXX 1,↔ADDI 1,=180↔PUSH P,1
CALL(AVECT)
CALL(AIVECT,[=250],[=180])
CALL(COS,TTRAD0)↔FMPR 1,[150.0]↔FIXX 1,↔ADDI 1,=250↔PUSH P,1
CALL(SIN,TTRAD0)↔FMPR 1,[150.0]↔FIXX 1,↔ADDI 1,=180↔PUSH P,1
CALL(AVECT)
CALL(DPYOUT,[15])
POP0J
;-----------------------------------------------------------------
;III DISPLAY SUBROUTINES.
FLGIII:-1
FLGDD:0
;DISPLAY UUO CODES.
OPDEF UPG [XWD 703000,0]
A←1↔B←2↔C←3
DPYBUF: DPYBU.
=350↔1↔XWD 1,=350
DPYBU.: BLOCK =350
IGNORE: 0
DPYPTR: 0
BUFEND: 0
BUFHD: 0
0
;III DPY CONTINUED.
DPYBIG: LAC 1,ARG1
LACI 3,46 ;ZERO LENGTH RELATIVE-INVISIBLE VECTOR
DPB 1,[POINT 3,3,27]
PUSH P,(P) ;COPY PC.
GO LV2
DPYBRT: LAC 1,ARG1
LACI 3,46
DPB 1,[POINT 3,3,24]
PUSH P,(P) ;COPY PC.
GO LV2
RIVECT: SKIPA C,[46]
RVECT: LACI C,6
GO LV0
AIVECT: SKIPA C,[146] ;INVISIBLE ABSOLUTE.
AVECT: LACI C,106
LV0: SKIPGE IGNORE↔POP2J
LV: LAC A,ARG2↔LAC B,ARG1
LVC: DPB A,[POINT 11,C,10]
DPB B,[POINT 11,C,21]
LV2: AOS A,DPYPTR↔DAC C,(A)
LV3: LIPI A,<(<POINT 7,0,35>)>
DAC A,DPYPTR↔LACI A,(A)
CAML A,BUFEND↔SETOM IGNORE
POP2J
;--------------------------------------------------------------
;III DPY CONTINUED.
DPYSTR: LAC 3,ARG1
LIPI 3,440700
ILDB 3↔JUMPE POP1J.
CALL(DTYO,0)↔GO DPYSTR+2
DTYO: LAC 1,ARG1
IDPB A,DPYPTR
CDR A,DPYPTR
CAML A,BUFEND
SETOM IGNORE
POP1J
DPYCLR: SKIPL DPYFLG#
DPYCLR
DZM BUFHD
POPJ P,
DPYOUT:
SKIPN 1,BUFHD↔GO .+6
LAC 2,DPYPTR↔DAC 2,-2(1)
LACI 2,2(2)↔SUB 2,1↔DAC 2,-1(1)
CDR B,DPYPTR
SUB B,BUFHD
ADDI B,1
DAC B,BUFHD+1
LAC 1,ARG1
DPB A,[POINT 4,.+3,12]↔IOR A,DPYFLG↔SKIPL A↔UPG BUFHD
POP1J
DPYSET: DZM DPYFLG
LAC 1,ARG1
ADDI 1,2
DAC 1,BUFHD
CDR 2,-3(1) ;SIZE
ADDI 2,-3(1)
SUBI 2,1
DZM IGNORE
DAC 2,BUFEND
CLR2: LAC A,BUFHD
LACI B,1
DAC B,1(A)
LACI B,2(A)
LIPI B,1(A)
BLT B,@BUFEND ;SET DPY BUFFER TO NULL CHARACTER WORDS
PUSH P,(P) ;COPY PC.
GO LV3
;III DISPLAY ROUTINES.
SUBR(OD)----------------------------------------------------------
BEGIN OD;OCTAL HALF WORD DISPLAY - BGB - 13 DEC 1972.
LACI 7,6↔DIPZ 10,10↔SETO
L: ROT 10,3↔ADDI 10,60↔TRNE 10,17↔SETZ
JUMPN 0,.+3↔CALL(DTYO,10)↔ZAP 10↔SOJG 7,L
CALL(DTYO,[" "])↔POP0J
BEND;12/13/72-----------------------------------------------------
SUBR(DECDPY)NUM ;DECIMAL DISPLAY NUMBER.
BEGIN DECDPY;-----------------------------------------------------
L: JUMPGE 1,.+5
MOVM 2,1
CALL(DTYO,["-"])
LAC 1,2
IDIVI 1,12
PUSH P,2
SKIPE 1
PUSHJ P,L
POP P,1↔ADDI 1,60
CALL(DTYO,1)
POP0J
BEND DECDPY;12/17/72----------------------------------------------
;SUBR(SQRT)
SUBR(SQRT)--------------------------------------------------------
BEGIN SQRT;MODIFIED OLDE LIB40 SQUARE ROOT - BGB - TRADITIONAL.
A←0 ↔ B←1 ↔ C←2
MOVM B,ARG1↔JUMPE B,POP1J.↔PUSH P,2
;LET X=F*(2↑2B) WHERE 0.25<F<1.00 THEN SQRT(X)=SQRT(F)*(2↑B).
ASHC B,-=27↔SUBI B,201 ;GET EXPONENT IN B, FRACTION IN C.
ROT B,-1 ;CUT EXP IN HALF, SAVE ODD BIT
HRRM B,L↔LSH B,-=35 ;USE THAT ODD BIT.
ASH C,-10↔FSC C,177(B) ;0.25 < FRACTION < 1.00
;LINEAR APPROXIMATION TO SQRT(F).
MOVEM C,A
FMP C,[0.8125↔0.578125](B)
FAD C,[0.302734↔0.421875](B)
;TWO ITERATIONS OF NEWTON'S METHOD.
MOVE B,A
FDV B,C↔FAD C,B↔FSC C,-1
FDV A,C↔FADR A,C
L: FSC A,0↔MOVE 1,A↔POP P,2
POP1J↔LIT
BEND;28/12/72-----------------------------------------------------
BEGIN SINCOS ;SINE & COSINE - BGB.
A←1 ↔ B←2 ↔ C←3
↑COS: SKIPA A,ARG1
↑SIN: SKIPA A,ARG1
FADR A,HALFPI ;COS(X) = SIN(X+π/2).
MOVM B,A↔CAMG B,[17B5]↔POP1J ;FOR SMALL X, SIN(X)=X.
;B ← (ABS(X)MODULO 2π)/HALFPI
;C ← QUADRANT 0, 1, 2 OR 3.
FDVR B,HALFPI
LAC C,B↔FIX C,233000
CAILE C,3↔GO[
TRZ C,3↔FSC C,233
FSBR B,C↔GO .-3] ;MODULO 2π.
GO .+1(C)↔GO .+4↔JFCL↔GO[
FSBRI B,(2.0)↔MOVNS B↔GO .+2] ;SIN(X+π)=SIN(-X)
FSBRI B,(4.0) ;SIN(X+2π)=SIN(X)
SKIPGE A↔MOVNS B ;SIN(-X) = -SIN(X).
;FOR -1 ≤ B ≤ +1 REPRESENTING -π/2 ≤ X ≤ +π/2,
;COMPUTE SINE(X) APPROXIMATION BY TAYLOR SERIES.
DAC B,C↔FMPR B,B
LAC A,[164475536722]↔FMP A,B
FAD A,[606315546346]↔FMP A,B
FAD A,[175506321276]↔FMP A,B
FAD A,[577265210372]↔FMP A,B
FAD A,HALFPI↔FMPR A,C↔POP1J
HALFPI: 201622077325 ;PI/2
LIT
BEND;-------------------------------------------------------------
SUBR(READARC) ;RETURNS RADIANS.
BEGIN READARC;-------------------------------------------------------
SETZM PIFLAG ;FLAG INDICATES THAT π APPEARS IN EXPR.
CALL(REALIN)
SKIPN PIFLAG
FMPR[0.0174533] ;CONVERT DEGREES INTO RADIANS.
POP0J
BEND READARC;--------------------------------------------------------
PIFLAG:0
INTERN REALI
REALI: GO REALIN
SUBR(REALIN)
BEGIN REALIN;--------------------------------------------------------
;<EXPR> ::= <EXPR>+<TERM>|<EXPR>-<TERM>|<TERM>
;<TERM> ::= <TERM>*<PRIMARY>|<TERM>/<PRIMARY>|<PRIMARY>
;<PRIMARY> ::= -<PRIMARY>|(<EXPR>)||π|<REAL NUMBER>
CALL(TERM)
CAIN 1,"+"↔GO[
PUSH P,0↔CALL(TERM)↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
CAIN 1,"-"↔GO[
PUSH P,0↔CALL(TERM)↔MOVN 0,0↔FADR 0,(P)
SUB P,[XWD 1,1]↔GO REALIN+1]
POP0J↔POP0J
TERM: CALL(PRIMARY)
TERM2: CAIN 1,"*"↔GO[
PUSH P,0↔CALL(PRIMARY)↔FMPR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
CAIN 1,"/"↔GO[
PUSH P,0↔CALL(PRIMARY)↔EXCH 0,(P)↔FDVR 0,(P)
SUB P,[XWD 1,1]↔GO TERM2]
POP0J
;BEGIN REALIN ; INPUT SMALL REAL NUMBER - BGB - 16 DEC 1972
;AC-0 INTEGER ACCUMULATION. AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER. AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
PRIMARY:SETZ↔SETZB 2,3
L0: CALL(GETCHR)
CAIN 1," "↔GO .-2
CAIN 1,"-"↔GO[SETCMM 3↔GO L0]
CAIN 1,"π"↔GO[SETOM PIFLAG↔MOVE 0,[3.1415926]
GETRET: CALL(GETCHR)↔GO L3]
CAIN 1,"("↔GO[PUSH P,3↔CALL(REALIN)↔POP P,3
CAIN 1,")"↔GO GETRET
OUTSTR[ASCIZ/WARNING: MISSING ')'
/]↔ POP0J]
SKIPA
L1: CALL(GETCHR)
CAIN 1,";"↔GO L2↔CAIN 1,","↔GO L2
CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
CAIL 1,"0"↔CAILE 1,"9"↔GO L2
JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2: CAIN 1,15↔CALL(GETCHR)
FLOAT↔SOSLE 2
FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
L3: SKIPE 3↔MOVNS↔POP0J
BEND REALIN;12/16/72(BGB),14-MAR-73(TVR)-----------------------------
GETCHR: INCHRW 1↔POP0J
END